perm filename FLTR.F4[SCR,LCS] blob
sn#204256 filedate 1976-03-01 generic text, type T, neo UTF8
00100 C******* 'FILTER' -- AVOIDS FOLDOVER ON HIGH NOTES *********
00200 SUBROUTINE SUBR
00300 DIMENSION PX(30)
00400 COMMON /INS/ INST(27),BG(60)
00500 COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
00600 C INUM=INST# IPAR=PARAM#
00700 C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00800 C IF IREST IS <0, THAT NOTE WILL BE A REST.
00900 C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
01000 C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
01100 C F1=86 F15=100 (NO F16!)
01200
01300 IF(INUM.NE.1)GO TO 1
01400 X=P(3)
01500 C WE'LL SAVE THE FREQ. IN X.
01600 IF(PL(3).EQ.1)RETURN
01700 C NEXT FOR LETTER NAMED NOTES
01800 X=IFIX(X)
01900 C FIX THE NOTE NUM. IN CASE IT WAS RANDOMLY SELECTED.
02000 X=30.8677*2**(X/12.)
02100 RETURN
02200
02300 C NEXT SETS UP SYNTH VALUES.
02400 1 S=P(29)*500.
02500 C HALF THE SAMPLE RATE.
02600 P(29)=999.
02700 C 999 TO CONCLUDE SYNTH INPUT TO MUSIC PROG.
02800 K=S/X
02900 C HOW MANY TIMES WILL THE FREQ. FIT INTO THE SRATE.
03000 IF(K.LT.14)GO TO 3
03100 4 IF(BT.GT.0)IREST=-1
03200 C GIVE INVIS. "INSTRUMENT" A REST IF NO CHANGE.
03300 RETURN
03310 C RETURN IF THEY ALL FIT
03400 3 J=(K-2)*2
03500 C FOR DO-LOOP BELOW
03600 F=1.0
03700 DO 2 L=J,28,2
03710 F=F-.25
03750 IF(L.LT.4)GO TO 2
03780 IF(F.LE.0)GO TO 20
03800 P(L)=P(L)*F
03900 C SCALE DOWN THIS HARMONIC
04000 GO TO 2
04200 20 P(L)=0
04300 C ZERO OUT THIS HARMONIC
04400 2 CONTINUE
04500 C NEXT TO SAVE TIME IN THE MUSIC PROGRAM.
04600 DO 5 K=4,28,2
04700 C JUMP OUT OF LOOP IF SOME CHANGE IS ENCOUNTERED.
04800 5 IF(P(K).NE.PX(K))GO TO 6
04900 GO TO 4
05000 C TURN IT INTO A REST IF NO CHANGES FROM LAST TIME
05100
05200 6 DO 7 L=K,28,2
05300 7 PX(L)=P(L)
05400 C SAVE VALUES FOR NEXT TIME AROUND.
05500 RETURN
05600 END
05650
05690 C **** TYPICAL INPUT ****
05700 C TOOT 0 12;
05800 C P2 .2;
05900 C P3 MOVE/6 C3 B7/6 B7 C3;
06000 C P4 2000;
06100 C P5 F1;
06200 C P6 F3 SUBR;
06300 C END;
06400 C FUNC INVIS 0 12;
06500 C P2 P2;
06600 C P3 "SYNTH(F3);1 1 2";
06700 C P4 .9; % OF 2ND HARM.
06800 C P5 3; P6 .85; P7 4; P8 .8;
06900 C P9 5; P10 .75; P11 6; P12 .7;
07000 C P13 7; P14 .65; P15 8; P16 .6;
07100 C P17 9; P18 .55; P19 10; P20 .5;
07200 C P21 11; P22 .45; P23 12; P24 .4;
07300 C P25 13; P26 .35; P27 14; P28 .3;
07400 C P29 12.8 SUBR; SAMPLE RATE IN K.
07500 C END;